;; ########################################################
;; mosaic1.lsp - Version 2, November 2002
;; Copyright (c) 1998 by Forrest W. Young & Ernest Kwan
;; Code to implement mosaic plot object prototype.
;; Mosaic drawing algorithm by Ernest Kwan. Wrapper by FWY.
;; Major cell positioning bug fixed by Pedro Valero, Nov 02
;; ########################################################


 #|THIS IS THE OLD CONSTRUCTOR FUNCTION 
   IT IS REPLACED BY CODE IN PLOTS003.LSP BY FWY DEC 2002

(defun mosaic-plot 
  (cells levels 
         &key freq  color-values (standardize t)  plot-values
         connect-button gaps 
         way-labels level-labels
         (legend1 (send current-object :name)) (legend2 "Mosaic Plot")
         (title "Mosaic Plot")  (show t)
         (size '(250 250)) (location '(50 50)) )
"Args: CELLS LEVELS &KEY FREQ COLOR-VALUES (STANDARDIZE T) CONNECT-BUTTON PLOT-BUTTON GAPS WAY-LABELS LEVEL-LABELS POINT-LABELS LEGEND1 LEGEND2 TITLE (SHOW T) SIZE LOCATION
Creates a mosaic plot of N-way table data. 
Restrictions: 6-way data; 100 cells. 
CELLS is a list of cells in way-major order. 
LEVELS specifies number of levels for each way. 
FREQ specifies that the data are frequency data. 
COLOR-VALUES is a list in same order as CELLS, which is used to color cells according to the specified values (which are standardized unless STANDARDIZE is NIL). 
PLOT-VALUES is a list of lists of values, the lists in same order as CELLS. Each list is used to make plots within cells. A button is placed on the tool bar giving the user the choice of random, dot, quantile and normal probability plots.
CONNECT-BUTTON specifies that the connect button is to appear on the tool bar, giving the user the choice to connect by rows or columns or both.
GAPS is a list of nway values which specify spacing between tiles (default is 5 for each way)."
  #-msdos(warning-message "Mosaic Plots do not draw correctly for this preview release of ViSta 6 for the Mac (they work in ViSta for Windows.)")
  (cond
    ((> (max levels) 12) (fatal-message "Too Many Levels for Mosaic Plot. Maximum is 12")(top-level))
    ((> (length cells) 96) (fatal-message "Too Many Cells for Mosaic Plot. Maximum is 96")(top-level))
    ((> (length levels) 4) (fatal-message "Too Many Ways for Mosaic Plot. Maximum is 4")(top-level))
    (t
  (send mosaic-proto :new cells levels freq 
        plot-values color-values standardize 
        connect-button (if plot-values t nil) gaps
        way-labels level-labels legend1 legend2 
        title show size location))))
|#
(defproto mosaic-proto 
  '(cells levels freq original-mx draw-mx shaded-cells ways gaps fill total 
          plottype way-labels plotvalues color-values point-labels shading 
          rects to-label legend1 legend2 setting-margins tick-mark-labels
          dynamic-tick-mark-labels 
          brushing-info propagating connection-type bar
          x-tick-mark-locs y-tick-mark-locs tick-marks-showing point-xy-nums
          standardize-shading level-labels rect-centers colored-tiles
          hilite-rect)
  () graph-proto)



(defmeth mosaic-proto :isnew 
  (cells levels freq 
         plot-values color-values standardize 
         connect-button plot-button gaps
         way-labels level-labels legend1 legend2 
         title show size location)
  (call-next-method 2 :show nil)
  (send self :add-mouse-mode 'new-brush
        :title "Brushing"
        :motion :brushing
        :cursor 'pointy-brush)
  (send self :mouse-mode 'new-brush)
  (apply #'send self :size size)
  (apply #'send self :location location) 
  (send self :fixed-aspect t)
  (send self :legend1 legend1)
  (send self :legend2 legend2)
  (send self :title title)
  (send self :use-color t)
  (send self :x-axis t t 0) ;t nil 0
  (send self :y-axis t t 0) ;t nil 0
 ; (send self :mouse-mode 'brushing)
  (send self :showing-labels t)
  (send self :brush 0 0 0 0)
 ; (send self :menu nil)
  (send self :fill nil)
  (send self :connection-type 0)
  (send self :plot-buttons :new-x nil :new-y nil :mouse-mode nil
        :connect connect-button :tiles plot-button)
  (send self :another-margin (length levels))

  (when (and cells levels)
        (send self :new-plot cells levels :freq freq 
              :plot-values plot-values :color-values color-values 
              :standardize standardize :gaps gaps 
              :way-labels way-labels :level-labels level-labels
              :show show))
  (send self :make-two-plot-menus
                "Mosaic"
                :hotspot-items '(help dash 
                                 print save copy dash on-top maximize)
                :popup-items   '(showing-labels))
  ;(send self :new-menu "Mosaic";
	; :items '(help dash print save copy))
  self)

(defmeth mosaic-proto :new-plot 
  (cells levels  &key freq plot-values color-values (standardize  t)
         gaps way-labels level-labels show)
   (cond
    ((> (max levels) *mosaic-bargraph-max-level*)   
     (fatal-message 
      (format nil "Too Many Levels (~d) for BarGraph. Maximum is ~d. Select variables with fewer categories." 
              (max levels) *mosaic-bargraph-max-level* ))
     (top-level nil))
    ((> (length cells) *mosaic-bargraph-max-cells*) 
     (fatal-message 
      (format nil "Too Many Cells (~d) for BarGraph. Maximum is ~d. Select fewer variables, or select variables with fewer categories."
              (length cells) *mosaic-bargraph-max-cells*))
     (top-level))
    ((> (length levels) *mosaic-bargraph-max-ways*)
     (fatal-message 
      (format nil "Too Many Ways (~d) for BarGraph. Maximum is ~d. Please select fewer categorical variables."
              (length cells) *mosaic-bargraph-max-ways*))
     (top-level nil))
    (t
  (when (and freq (= (length levels) 2)) ;transpose if 2-way frequency data
        (setf cells (combine (row-list (transpose (matrix levels cells)))))
        (when color-values 
              (setf color-values 
                    (combine (row-list (transpose (matrix levels color-values))))))
        (when plot-values 
              (setf plot-values 
                    (combine (row-list (transpose (matrix levels plot-values))))))
        (setf levels (reverse levels))
        (setf level-labels (reverse level-labels))
        (setf way-labels (reverse way-labels)))
  (when color-values 
        (when (/= (length cells) (length color-values ))
              (fatal-message "When you specify color values, there must be one for each data cell.")))
  (when plot-values
        (when (/= (length plot-values) (length cells))
              (fatal-message "When you specify variable plot-values, there must be a list for each data cell.")))
  ;fwy changed following nov 2002
 ; (send self :color-values 
 ;       (if standardize 
 ;           (if (< (length (remove-duplicates color-values)) 2);cope with nil
 ;               (repeat 0.0 (length cells));length cells is always right, not so color-value
 ;               (standardize color-values))
 ;           color-values))
  (send self :color-values 
        (if color-values color-values
            (combine (send self :chi-sq-contributions cells levels))))
  (if (and standardize (> (length (remove-duplicates (send self :color-values))) 1))
      (send self :color-values (standardize (send self :color-values))))
  (send self :shading (send self  :color-values))
  (send self :hilite-rect nil)
  (send self :brushing-info nil)
  (send self :colored-tiles nil)
  (setf cells (round cells))
  (send self :freq freq)
  (send self :cells cells)
  (send self :levels levels)
  (send self :ways  (length levels))
  (when (> (send self :ways) 4) 
        (fatal-message "Mosaic Plot cannot use more than 4 way data"))
  (send self :total (length cells))
  (when (not way-labels) 
        (setf way-labels 
              (mapcar #'(lambda (i) (format nil "Way~d" i))
                      (iseq (send self :ways)))))
  (send self :way-labels way-labels)
  (when (not level-labels)
        (setf level-labels 
              (mapcar #'(lambda (lab i)
                          (iseq i) ;(repeat lab i)
                          )
                      way-labels levels)))
  (setf level-labels 
        (mapcar #'(lambda (labels)
                    (if (stringp (first labels))
                        labels
                        (mapcar #'(lambda (label)
                                    (format nil "~s" label))
                                labels)
                        ))
                level-labels))
  (send self :level-labels level-labels)
  (cond
    ((and way-labels level-labels)
     (send self :to-label t))
    ((or way-labels level-labels)
     (vista-message "Axes are labeled only when both the way labels and level labels are specified.")))
  (send self :point-labels nil)
  (send self :tick-mark-labels (list nil nil))
  (send self :x-tick-mark-locs nil)
  (send self :y-tick-mark-locs nil)
  (send self :rects nil)
  (send self :standardize-shading standardize)
  (send self :gaps 
        (if (not gaps)
            (* (repeat 5 (send self :ways)) 
               (reverse (1+ (iseq (send self :ways)))))
            gaps))
  (send self :plotvalues plot-values)
  (send self :original-mx  
        (coerce (+ (send self :content-rect) '(0 0 -6 -6)) 'vector))

  (reset-graphics-buffer)
  (send self :start-buffering)
  (send self :prepare)
  (send self :range 0 0 100)
  (send self :range 1 0 100)
  (send self :add-mosaic)
  (when (send self :shading)
        (send self :colored-tiles t)
        (when (not (send self :bar))
              (send self :add-color-spectrum)))
  (send self :dynamic-tick-mark-labels 
        (send self :make-dynamic-tick-mark-labels))
  (let ((choice (position (send self :plottype) 
                          '("dotplot" "random" "qplot" "npplot") 
                          :test #'equal)))
    (when choice (send self :make-subplots (1+ choice))))
;following two statements do not work right in other order for mswin
  (send self :redraw)
  (send self :buffer-to-screen)
  
  (when show (send self :show-window))
  self)))

(defmeth mosaic-proto :cells (&optional (cells nil set))
  (if set (setf (slot-value 'cells) cells))
  (slot-value 'cells))

(defmeth mosaic-proto :colored-tiles (&optional (logical nil set))
  (if set (setf (slot-value 'colored-tiles) logical))
  (slot-value 'colored-tiles))

(defmeth mosaic-proto :freq (&optional (logical nil set))
  (if set (setf (slot-value 'freq) logical))
  (slot-value 'freq))

(defmeth mosaic-proto :shading (&optional (shading nil set))
  (if set (setf (slot-value 'shading) shading))
  (slot-value 'shading))

(defmeth mosaic-proto :standardize-shading (&optional (logical nil set))
  (if set (setf (slot-value 'standardize-shading) logical))
  (slot-value 'standardize-shading))

(defmeth mosaic-proto :color-values (&optional (list nil set))
  (if set (setf (slot-value 'color-values) list))
  (slot-value 'color-values))

(defmeth mosaic-proto :setting-margins (&optional (logical nil set))
  (if set (setf (slot-value 'setting-margins) logical))
  (slot-value 'setting-margins))

(defmeth mosaic-proto :propagating (&optional (logical nil set))
  (if set (setf (slot-value 'propagating) logical))
  (slot-value 'propagating))

(defmeth mosaic-proto :bar (&optional (logical nil set))
  (if set (setf (slot-value 'bar) logical))
  (slot-value 'bar))

(defmeth mosaic-proto :legend1 (&optional (str nil set))
  (if set (setf (slot-value 'legend1) str))
  (slot-value 'legend1))

(defmeth mosaic-proto :legend2 (&optional (str nil set))
  (if set (setf (slot-value 'legend2) str))
  (slot-value 'legend2))

(defmeth mosaic-proto :fill (&optional (str nil set))
  (if set (setf (slot-value 'fill) str))
  (slot-value 'fill))

(defmeth mosaic-proto :rects (&optional (list nil set))
  (if set (setf (slot-value 'rects) list))
  (slot-value 'rects))

(defmeth mosaic-proto :levels (&optional (levels nil set))
  (if set (setf (slot-value 'levels) levels))
  (slot-value 'levels))

(defmeth mosaic-proto :to-label (&optional (list nil set))
  (if set (setf (slot-value 'to-label) list))
  (slot-value 'to-label))

(defmeth mosaic-proto :way-labels (&optional (list nil set))
  (if set (setf (slot-value 'way-labels) list))
  (slot-value 'way-labels))

(defmeth mosaic-proto :point-labels (&optional (point-labels nil set))
  (if set (setf (slot-value 'point-labels) point-labels))
  (slot-value 'point-labels))

(defmeth mosaic-proto :level-labels (&optional (list nil set))
  (if set (setf (slot-value 'level-labels) list))
  (slot-value 'level-labels))

(defmeth mosaic-proto :tick-mark-labels (&optional (list-of-lists nil set))
  (if set (setf (slot-value 'tick-mark-labels) list-of-lists))
  (slot-value 'tick-mark-labels))

(defmeth mosaic-proto :dynamic-tick-mark-labels (&optional (list-of-lists nil set))
  (if set (setf (slot-value 'dynamic-tick-mark-labels) list-of-lists))
  (slot-value 'dynamic-tick-mark-labels))

(defmeth mosaic-proto :original-mx (&optional (original-mx nil set))
  (if set (setf (slot-value 'original-mx) original-mx))
  (slot-value 'original-mx))

(defmeth mosaic-proto :draw-mx (&optional (draw-mx nil set))
  (if set (setf (slot-value 'draw-mx) draw-mx))
  (slot-value 'draw-mx))

(defmeth mosaic-proto :rect-centers (&optional (mx nil set))
  (if set (setf (slot-value 'rect-centers) mx))
  (slot-value 'rect-centers))

(defmeth mosaic-proto :hilite-rect (&optional (integer nil set))
  (if set (setf (slot-value 'hilite-rect) integer))
  (slot-value 'hilite-rect))

(defmeth mosaic-proto :ways (&optional (ways nil set))
  (if set (setf (slot-value 'ways) ways))
  (slot-value 'ways))

(defmeth mosaic-proto :gaps (&optional (gaps nil set))
  (if set (setf (slot-value 'gaps) gaps))
  (slot-value 'gaps))

(defmeth mosaic-proto :total (&optional (total nil set))
  (if set (setf (slot-value 'total) total))
  (slot-value 'total))

(defmeth mosaic-proto :plottype (&optional (plottype nil set))
  (if set (setf (slot-value 'plottype) plottype))
  (slot-value 'plottype))

(defmeth mosaic-proto :plotvalues (&optional (plotvalues nil set))
  (if set (setf (slot-value 'plotvalues) plotvalues))
  (slot-value 'plotvalues))

(defmeth mosaic-proto :brushing-info (&optional (list nil set))
  (if set (setf (slot-value 'brushing-info) list))
  (slot-value 'brushing-info))

(defmeth mosaic-proto :x-tick-mark-locs (&optional (list nil set))
  (if set (setf (slot-value 'x-tick-mark-locs) list))
  (slot-value 'x-tick-mark-locs))

(defmeth mosaic-proto :y-tick-mark-locs (&optional (list nil set))
  (if set (setf (slot-value 'y-tick-mark-locs) list))
  (slot-value 'y-tick-mark-locs))

(defmeth mosaic-proto :tick-marks-showing (&optional (list nil set))
  (if set (setf (slot-value 'tick-marks-showing) list))
  (slot-value 'tick-marks-showing))

(defmeth mosaic-proto :point-xy-nums (&optional (lol nil set))
  (if set (setf (slot-value 'point-xy-nums) lol))
  (slot-value 'point-xy-nums))

(defmeth mosaic-proto :connection-type (&optional (str nil set))
  (if set (setf (slot-value 'connection-type) str))
  (slot-value 'connection-type))

(defmeth mosaic-proto :prepare ()
  (let* ((cells (send self :cells))
         (levels (send self :levels))
         (gaps (send self :gaps))
         (ways (send self :ways))
         (total (send self :total)))
    (cond 
      ((> (length cells) 1)
       (cond 
         ((not (send self :bar))  ;my modification does not work with bar graphs
          (setf odds (which (mapcar 'oddp (iseq ways))))
         ; (when odds (setf gapsodds (*  1 (select (send self :levels) odds) (select (list 5 1 1 1) odds)))
         ; (setf (select gaps odds) (select gapsodds (iseq (length odds)))))
          (setf evens (which (mapcar 'evenp (iseq ways))))
          (setf gapsevens (* 1 (select (send self :levels) evens) (select (list 5 1 1 1) evens)))
         ;(setf (select gaps evens) (select gapsevens (iseq (length evens))))
          (setf counter 0)
          (setf listways (iseq ways))
          (setf listways 
                (remove 'nil
                        (combine 
                         (select listways (which (mapcar 'evenp (iseq ways))))
                         (select listways (which (mapcar 'oddp (iseq ways)))))))
         (setf cells (select cells (send self :correct-position-cells)))
          (dolist (i listways)
                  (let* ((current-levels (elt levels i))
                         (current-gap (elt gaps i))
                         (split (if (evenp i) 0 1))
                         (stem (reduce #'* (select levels (select listways (iseq counter (1- ways))))))
                         (leaf (/ total (reduce #'* (select levels (select listways (iseq 0 counter))))))
                         (nr-ls (split-list cells stem))
                         (dr-ls (mapcar #'sum (split-list cells stem)))
                         (divis-result (/0 nr-ls dr-ls 0))
                         (uncut-ls (combine (first divis-result)))
                         (cut-ls (split-list uncut-ls leaf))
                         (ps (mapcar #'sum cut-ls))
                         (mx (send self :original-mx))
                         (bad-mx
                          (send self :matrix-span mx ps 
                                current-levels current-gap split)) ;ng if ways=1
                         (good-mx (send self :clean-matrix bad-mx)))
                    (send self :original-mx good-mx)
                    (setf counter (1+ counter))
                    ))

          )
         (t (dotimes (i ways t)
                     (let* ((current-levels (elt levels i))
                            (current-gap (elt gaps i))
                            (split (if (evenp i) 0 1))
                            (stem (reduce #'* (select levels (iseq i (- ways 1)))))
                            (leaf (/ total (reduce #'* (select levels (iseq 0 i)))))
                            (nr-ls (split-list cells stem))
                            (dr-ls (mapcar #'sum (split-list cells stem)))
                            (divis-result (/0 nr-ls dr-ls 0))
                            (uncut-ls (combine (first divis-result)))
                            (cut-ls (split-list uncut-ls leaf))
                            (ps (mapcar #'sum cut-ls))
                            (mx (send self :original-mx))
                            (bad-mx
                             (send self :matrix-span mx ps 
                                   current-levels current-gap split)) ;ng if ways=1
                            (good-mx (send self :clean-matrix bad-mx)))
                       (send self :original-mx good-mx)
                       )))))
       (t (send self :original-mx (bind-rows (send self :original-mx)))))
    (send self :draw-mx (send self :original-mx))
    (send self :rect-centers 
          (floor (/ (mapcar #'(lambda (vector) 
                                (let ((xywh (coerce vector 'list)))
                                  (list (+ (* 2 (first xywh)) (third xywh))
                                        (+ (* 2 (second xywh)) (fourth xywh)))))
                            (row-list (send self :draw-mx))) 2)))
    ))

(defmeth mosaic-proto :matrix-span 
               (mx ps current-levels current-gap split)
  (let* ((siz (array-total-size mx))
         (all-rows (make-array siz :displaced-to mx))
         (rows (/ siz 4))
         (new '#(0 0 0 0)))
    (dotimes (j rows new)
             (let* ((the-row (+ '(0 1 2 3) (* 4 j)))
                    (the-ps (+ (iseq 0 (- current-levels 1)) 
                               (* current-levels j)))
                    (part (send self :row-span 
                                     (select all-rows the-row) 
                                     (select ps the-ps) current-gap split)))
               (setf new (send self :join-2-matrix new part))))))

(defmeth mosaic-proto :row-span (special-row special-ps g split)
  (let* ((r (length special-ps))
         (bg (round (/ g (- r 1))))
         (c3 (if (= split 0) 
                 (round (* (- (elt special-row 2) g) special-ps));round
                 (repeat (elt special-row 2) r)))
         (c4 (if (= split 1)
                 (round (* (- (elt special-row 3) g) special-ps));round
                 (repeat (elt special-row 3) r)))
         (c1 (if (= split 0)
                 (select (cumsum (combine (elt special-row 0) (+ c3 bg)))
                         (iseq 0 (- r 1)))
                 (repeat (elt special-row 0) r)))
         (c2 (if (= split 1)
                 (select (cumsum (combine (elt special-row 1) (+ c4 bg)))
                         (iseq 0 (- r 1)))
                 (repeat (elt special-row 1) r))))
    (bind-columns c1 c2 c3 c4)))

(defmeth mosaic-proto :join-2-matrix (mx-A mx-B)
  (let* ((siz-A (array-total-size mx-A))
         (siz-B (array-total-size mx-B))
         (elements-A (make-array siz-A :displaced-to mx-A))
         (elements-B (make-array siz-B :displaced-to mx-B))
         (rows-A (/ siz-A 4))
         (rows-B (/ siz-B 4))
         (rows-AB (+ rows-A rows-B))
         (elements-AB (concatenate 'list elements-A elements-B)))
    (make-array (list rows-AB 4) :initial-contents elements-AB)))

(defmeth mosaic-proto :clean-matrix (bad-mx)
  (let* ((siz (array-total-size bad-mx))
          (true-rows (- (/ siz 4) 1))
          (clean-mx (select bad-mx (iseq 1 true-rows) '(0 1 2 3))))
     clean-mx))


(defmeth mosaic-proto :resize ()
  (call-next-method)
  (send self :size-it))

(defmeth mosaic-proto :size-it ()
  (send self :start-buffering)
  (send self :rects nil)
  (send self :hilite-rect nil)
  (when (send self :ways)
        (send self :fix-it))
  (send self :buffer-to-screen)
  )


(defmeth mosaic-proto :fix-it ()
  (send self :original-mx 
        (coerce (+ (send self :content-rect) '(0 0 -6 -6)) 'vector))
    (send self :prepare)
    (send self :add-mosaic))

(defmeth mosaic-proto :redraw ()
  (call-next-method)
  (send self :draw-it))

(defmeth mosaic-proto :draw-it ()
  (let* ((ways (send self :ways))
         (cr (send self :content-rect))
         (center (+ (first cr) (floor (/ (third cr) 2))))
         (st1 (send self :legend1))
         (st2 (send self :legend2)))
    (when (and st1 st2)
    (send self :draw-text st1 center 30 1 0)
    (send self :draw-text st2 center 45 1 0))))

(defmeth mosaic-proto :redraw-background ()
  (let ((tw (+ (send self :text-ascent) (send self :text-descent) 2))
        (cr (send self :content-rect))
        (size (send self :size))
        (draw-color (send self :draw-color)))
    (when (send self :to-label)
          (send self :draw-axis-labels tw cr size))
    (when (and (send self :showing-labels) (not (send self :point-labels)))
          (send self :point-labels 
                (send self :make-rect-labels)))))

(defmeth mosaic-proto :redraw-content ()
  (send self :start-buffering)
  (call-next-method)
  (send self :paint-rects)
  (send self :add-grid)
  (send self :buffer-to-screen)
  )

(defmeth mosaic-proto :clear (&optional empty)
  (send self :start-buffering)
  (send self :rects nil)
  (send self :clear-points)
  (send self :clear-lines)
  (when empty (send self :to-label nil))
  (send self :redraw)
  (send self :buffer-to-screen)
  )
  
(defmeth mosaic-proto :switch-use-color ()
  (send self :use-color (not (send self :use-color)))
  (send self :redraw)
  (send self :use-color))


(defmeth mosaic-proto :draw-axis-labels (tw cr size)
  (send self :draw-x-axis-labels tw cr size)
  (send self :draw-y-axis-labels tw cr size))

(defmeth mosaic-proto :draw-x-axis-labels (tw cr size)
"Args: TW CR SIZE
Makes tick marks and labels axes with way and level labels for each way."
(when (not (send self :setting-margins))
  (let* ((labels (send self :way-labels))
         (nlabels (length labels))
         (level-labels (send self :level-labels)) 
         (level-label)
         (lh (+ (send self :text-ascent) (send self :text-descent) 2))
         (margin (send self :margin))
         (n-each-level (mapcar #'length level-labels))
         (first-text-row (+ tw 2 (second cr) (fourth cr)))
         (second-text-row (+ tw first-text-row))
         (third-text-row (+ tw second-text-row))
         (xcenter (+ (first cr)  (floor (/ (third cr)  2))))
         (mx (send self :draw-mx))
         (rect-center-xy (send self :rect-centers))
         (xs) (ys) (nxcenters 0) (bottomcenters)
         (min-separation) (min-separation-needed) (xok) (ntextlines)
         (x-tick-mark-labels) 
         (dtl t);dynamic tick labels
         )
;X-AXIS
;draw tickmarks
    (setf ys (+ (second (column-list mx)) (fourth (column-list mx))))
    (setf nxcenters (if (> nlabels 2) 
                        (* (first n-each-level) (third n-each-level))
                        (first n-each-level)))
    (setf bottomcenters 
          (send self :find-edges 
                ys rect-center-xy (max ys) 0 nxcenters))
    (dotimes (i (length bottomcenters))
             (send self :draw-line 
                   (select bottomcenters i) (- first-text-row 12)
                   (select bottomcenters i) (- first-text-row 17)))
;prepare x-tick-mark-labels
    (cond
      ((< nlabels 3)
       (setf x-tick-mark-labels (select level-labels 0)))
      ((> nlabels 2)
       (setf x-tick-mark-labels
             (combine
              (mapcar #'(lambda (i) 
                          (repeat (select (select level-labels 0) i) 
                                  (select n-each-level 2))) 
                      (iseq (select n-each-level 0)))))
       (setf x-tick-mark-labels 
             (list x-tick-mark-labels
                   (repeat (select level-labels 2) 
                           (length (select level-labels 0)))))
       (setf x-tick-mark-labels
             (mapcar (lambda (l1 l2) (strcat l1 "*"l2)) 
                     (first x-tick-mark-labels) (second x-tick-mark-labels)))))
;determine if tickmark labels would overlap    
    (setf tws (mapcar #'(lambda (L) (send self :text-width L)) x-tick-mark-labels))
    (setf min-separation-needed
          (max (mapcar #'(lambda (a b) (/ (+ a b) 2)) 
                       (select tws (iseq (1- nxcenters))) 
                       (select tws (iseq 1 (1- nxcenters))) )))
    (setf min-separation (min (difference bottomcenters)))
    (setf xok (< min-separation-needed min-separation))
;display lables if enough room
    (when xok
          (mapcar #'(lambda (lab xloc) 
                      (send self :draw-text lab xloc first-text-row 1 0))
                  x-tick-mark-labels bottomcenters))
;x-axis label for 1 or two plotvalues
    (send self :draw-text 
          (if (> nlabels 2)
              (strcat (select labels 0) "*" (select labels 2))
              (select labels 0))
          xcenter second-text-row 1 0)
    (send self :x-tick-mark-locs (list bottomcenters first-text-row second-text-row))
    (send self :tick-mark-labels
          (list x-tick-mark-labels
                (second (send self :tick-mark-labels))))
    )))


(defmeth mosaic-proto :draw-y-axis-labels (tw cr size)
"Args: TW CR SIZE
Makes tick marks and labels axes with way and level labels for each way."
(when (not (send self :setting-margins))
  (let* ((labels (send self :way-labels))
         (nlabels (length labels))
         (level-labels (send self :level-labels)) 
         (level-label)
         (lh (+ (send self :text-ascent) (send self :text-descent) 2))
         (margin (send self :margin))
         (n-each-level (mapcar #'length level-labels))
         (first-text-col (- (first cr) tw))
         (second-text-col (- first-text-col tw))
         (third-text-col (- second-text-col tw))
         (ycenter (+ (second cr) (floor (/ (fourth cr) 2))))
         (mx (send self :draw-mx))
         (rect-center-xy (send self :rect-centers))
         (xs) (ys) (nycenters 0) (leftcenters)
         (min-separation) (min-separation-needed) 
         (xok) 
         (yok)
         (ntextlines)
         (x-tick-mark-labels)
         (y-tick-mark-labels)
         (dtl t);dynamic tick labels
         )
;Y-AXIS (if there is one)
    (when (> nlabels 1)
;tickmarks
          (setf ys (first (column-list mx)))
          (setf nycenters (if (> nlabels 3) 
                              (* (second n-each-level) (fourth n-each-level))
                              (second n-each-level)))
          (setf leftcenters (send self :find-edges 
                                  ys rect-center-xy (min ys) 1 nycenters))
          (when (= 2 leftcenters)
                (dotimes (i (length leftcenters))
                         (unless (and (= i 0) (send self :bar))
                                 (send self :draw-line 
                                       (+ first-text-col 5) (select leftcenters i) 
                                       (+ first-text-col 10) (select leftcenters i)))))
;tickmark labels
          (cond
            ((< nlabels 4)(setf y-tick-mark-labels (select level-labels 1)))
            ((> nlabels 3)
             (setf y-tick-mark-labels
                   (combine
                    (mapcar #'(lambda (i) 
                                (repeat (select (select level-labels 1) i) 
                                        (select n-each-level 3))) 
                            (iseq (select n-each-level 1)))))
             (setf y-tick-mark-labels 
                   (list y-tick-mark-labels
                         (repeat (select level-labels 3) 
                                 (length (select level-labels 1)))))
             (setf y-tick-mark-labels
                   (mapcar (lambda (l1 l2) (strcat l1 "*" l2))
                           (first y-tick-mark-labels) (second y-tick-mark-labels)))))          
;determine if tickmark labels would overlap    
          (setf tws (mapcar #'(lambda (L) (send self :text-width L))
                            y-tick-mark-labels))
          (setf min-separation-needed
                (max (mapcar #'(lambda (a b) (/ (+ a b) 2)) 
                             (select tws (iseq (1- nycenters))) 
                             (select tws (iseq 1 (1- nycenters))) )))
          (setf min-separation (min (difference leftcenters)))
          (setf yok (< min-separation-needed min-separation))          
;draw labels if won't overlap
          (when yok
                (mapcar #'(lambda (lab yloc) 
                            (send self :draw-text-up lab first-text-col yloc 1 0))
                        y-tick-mark-labels leftcenters))
          (send self :y-tick-mark-locs (list leftcenters first-text-col second-text-col))            
;axis label
          (send self :draw-text-up
                (if (> nlabels 3)
                    (strcat (select labels 1) "*" (select labels 3))
                    (select labels 1))
                second-text-col ycenter 1 0))
    (send self :tick-mark-labels
          (list (first (send self :tick-mark-labels))
                y-tick-mark-labels))
    (send self :tick-marks-showing (list xok yok))
    )))
  